perm filename QA5[2,DBL] blob
sn#016202 filedate 1972-12-17 generic text, type T, neo UTF8
00100 BEGIN
00200 EXPR ENTER();
00300 BEGIN
00400 PRINTSTR '"THE SYSTEM IS STARTED";
00500 S;PRINTSTR '"
00600
00700 PLEASE TYPE IN A REQUEST
00800
00900 ...";
01000 L←READ();
01050 LHOLD←L;
01100 IF NULL(L) THEN RETURN '"THE SYSTEM IS ENDED.";
01200 PRINT D(L);
01300 GO S;
01400 END;
01500 EXPR D(L);
01600 BEGIN NEW FN, A, N, RELATEDF;
01700 I←READINKNOWN();
01701 KNOWNF←IDATA[1];
01750 TARG←IDATA[2];
01775 NARG←IDATA[3];
01787 TRE←IDATA[4];
01793 BA1←IDATA[5];
01796 BA2←IDATA[6];
01800 FN←L[1];
01900 A←CDR(L);
02000 N←LENGTH(A);
02100 RELATEDF←'(NIL NIL NIL NIL);
02200 IF MEMBER(FN,KNOWNF) THEN RETURN K1(FN,A,N,RELATEDF)
02300 ELSE RETURN K2(FN,A,N,RELATEDF);
02400 END;
02500 EXPR INIT();
02600 BEGIN
02700 EXAMPLE←NIL;
02800 INF←0;
02900 ORD←'(NIL);
03000 PRINTSTR '"TYPE IN HOW DEEPLY WE SHOULD RECURSE BEFORE
03100 GIVING UP AS INFINITE LOOP (I SUGGEST 50) ...";
03200 LIMINFBASE←READ();
03300 F3 ← '(NIL); F2← F3; F4←F3; F5←F4; F6←F5; F7←F6;
03400 BA1←'(FN CAR CDR IDEN MINUS ATOM LISTP NUMBERP NULL
03500 LIST CONST1 ZERO1
03600 QUOTE EVAL LENGTH NOT HALF SUB1 ADD1 );
03700 BA2←'(CONS PI12 PI22 PLUS TIMES MEMBER APPEND
03800 GREATERP LESSP EQUAL AND OR NOT);
03900 PRINTSTR '"TYPE IN MESSAGE LEVEL (I SUGGEST 3)...";
04000 MSGLEVEL←READ();
04100 KNOWNF ←'(CAR CDR CONS IDEN
04200 PLUS TIMES MINUS
04300 ATOM LISTP NUMBERP NULL
04400 QUOTE EVAL
04500 LENGTH MEMBER
04600 GREATERP LESSP EQUAL
04700 AND OR NOT
04800 HALF PI12 PI22 ZERO1 ZERO2
04900 CONST1 CONST2 SUB1 ADD1 LIST APPEND FN);
05000 SCHEMA←'(DE FN(L) (COND
05100 ((EQUAL (F1 L) C1) (F2 L))
05200 ((EQUAL (F8 L) C3) (F9 L))
05300 ((OR (GT L) (AND (INFINITY ) ((CAR (GET F4 TARGS)) (F3 L))
05400 ((CAR (GET F6 TARGS)) (F5 L))
05500 ((CAR (GET F7 TARGS)) (F4 (F3 L)))
05600 ((CADR (GET F7 TARGS)) (F6 (F5 L))) ))
05700 (F7 (F4 (F3 L)) (F6 (F5 L))))
05800 (T C2)));
05900 I ← EVAL(SCHEMA);
06000 NARGS←'NARGS; TARGS←'TARGS;TRES←'TRES;
06100 RETURN PUTFORM();
06200 END;
06300 EXPR IDEN(A); A;
06400 EXPR HALF(A); A/2;
06500 EXPR K1(FN,A,N,RELATEDF);
06600 BEGIN NEW I;
06700 I← GET(FN,'NARGS);
06800 IF I=N OR I=11 THEN RETURN EVAL(L);
06900 PRINTSTR '"THIS FUNCTION TAKES EXACTLY";
07000 PRIN1(I);
07100 PRINTSTR '" ARGUMENT(S). ARE WE DEFINING A NEW BUT CLOSELY
07200 RELATED FUNCTION Y OR N ...";
07300 IF READ()='Y THEN RELATEDF[1,1]←FN
07400 ELSE PRINTSTR '"ARE WE DEFINING A NEW FUNCTION HERE OR
07500 NOT Y OR N ..."
07600 ALSO IF READ()='N THEN RETURN '"IGNORING THE REQUEST ENTIRELY";
07700 PRINTSTR '"PICK A NEW FUNCTION NAME TO REPLACE THIS NEWEST USE OF";
07800 PRIN1 FN;
07900 PRINTSTR '"...";
08000 FN←READ();
08100 IF MEMBER(FN,KNOWNF) THEN RETURN K1(FN,A,N,RELATEDF)
08200 ELSE RETURN K2(FN,A,N,RELATEDF);
08300 END;
08400 EXPR K2(FN,A,N,RELATEDF);
08500 BEGIN NEW II,I;
08600 PRINTSTR '"READY TO MAKE NEW FUNCTION. DO YOU WANT TO";
08700 PRINTSTR '" CHANGE YOUR REQUEST Y OR N...";
08800 IF READ()='Y THEN RETURN '"VERY WELL. IGNORING
08900 THE REQUEST ENTIRELY";
09000 FOR NEW J←1 TO LENGTH(KNOWNF)-1 DO
09100 PUTPROP(KNOWNF[J],NIL,'RVAL);
09200 F1←NIL; F2←NIL; F8←NIL;F9←NIL; EXAMPLE←NIL;
09300 CO←CDR(BA1); ORDER←<CO,CO,CO,BA1,CO,BA1,BA2>;
09400 PRINTSTR '"FOR EACH OF THE FOLLOWINGS FUNCTIONS, TYPE
09500 EITHER TH WORD STOP OR A FUNCTION NAME, A SPACE, AND THEN A
09600 1/2/3/4/5, MEANING THAT THE FN. IS DEFINITELY/PROBABLY/POSSIBLY
09700 /PROBABLY NOT/DEFINITELY NOT RELATED TO";
09800 PRIN1 (FN);
09900 PRINT (KNOWNF);
10000 FOR NEW J←1 TO LENGTH(KNOWNF) DO BEGIN
10100 S; I←READ();
10200 IF I= 'STOP THEN GO SSS;
10300 II←READ();
10400 PUTPROP (I, II, 'RVAL);
10500 IF MEMBER(II,'(1 2 3 4)) THEN
10600 RELATEDF[II] ← I CONS RELATEDF[II]
10700 ELSE IF NOT(I=5) THEN
10800 PRINTSTR '"NO,NO! TYPE IN ONE DIGIT FROM 1 TO 5!!!"
10900 ALSO GO S;
11000 SSS; END UNTIL I= 'STOP;
11100 PRINTSTR '"DO YOU THINK RECURSION (OR AN AUXILLIARY FN. WILL
11200 BE REQUIRED HERE Y OR N OR M(FOR MAYBE) ...";
11300 I←READ();
11400 IF I='Y THEN RETURN REC(FN,A,N,RELATEDF)
11500 ELSE RETURN NREC(FN,A,N,RELATEDF,I);
11600 END;
11700 EXPR PUTFORM();
11800 BEGIN NEW ID,NA,TA,TR;
11900 TF←NIL;
12000 IF MAKELISTS()=NIL THEN RETURN PRINTSTR '"MAKELISTS IS NIL";
12100 FOR NEW I←1 TO LENGTH(KNOWNF) DO
12200 BEGIN
12300 PF←NIL;
12400 PF[1]←'PF1; PF[2]←'PF2; PF[3]←'PF3; PF[4]← 'PF4;
12500 PF[5]←'PF5; PF[6]←'PF6; PF[7]←'PF7;
12600 PF[8]←'PF8; PF[9]←'PF9;
12700 ID←KNOWNF[I];
12800 NA←NARG[I];
12900 PUTPROP(ID,NA,'NARGS);
13000 TA←TARG[I];
13100 PUTPROP(ID,TA,'TARGS);
13200 TR←TRE[I];
13300 PUTPROP(ID,TR,'TRES);
13400 FOR NEW J←1 TO 9 DO PUTPROP(ID,TF[J,I],PF[J]);
13500 PUTPROP('FN,2,'RVAL);
13600 PUTPROP('FALSE,'(ANY),TARGS);
13700 END;
13800 END;
13900 EXPR MAKELISTS();
14000 BEGIN
14100 NARG ← '(1 1 2 11 11 11 1
14200 1 1 1 1 1 1 1 2 11 11 11 11 11 11 1 2 2 1 2 1 2 1 1 11 2 1);
14300 TARG←'((LISTP) (LISTP) (ATOM LISTP) (ANY ANY)
14400 (NUMBER NUMBER) (NUMBER NUMBER)
14500 (NUMBER) (ANY) (ANY) (ANY) (ANY) (ANY) (ANY) (ANY)
14600 (ANY LISTP) (NUMBER NUMBER) (NUMBER NUMBER) (ANY ANY)
14700 (ANY ANY) (ANY ANY) (ANY ANY) (NUMBER) (ANY ANY) (ANY ANY)
14800 (ANY) (ANY ANY) (ANY) (ANY ANY) (NUMBER) (NUMBER)
14900 (ANY) (ANYLIST ANYLIST) (ANY));
15000 TRE←'(ANY LISTP LISTP ANY NUMBER NUMBER NUMBER
15100 TF TF TF TF ANY ANY
15200 NUMBER TF TF TF TF TF TF TF NUMBER ANY ANY NUMBER
15300 NUMBER ANY ANY NUMBER NUMBER ANYLIST LIST ANY);
15400 TF[1]← '(7 7 0 5 0 0 14 5 14 14 10 25 14 10 0 0 0 0 0 0
15500 14 10 0 0 25 0 25 0 10 10 14 0 0);
15600 TF[2]← '(10 10 0 5 0 0 14 5 14 14 14 25 14 14 0 0 0 0 0 0
15700 25 10 0 0 10 0 10 0 14 14 7 0 0);
15800 TF[3] ← '(5 7 0 10 0 0 10 14 14 14 14 14 14 14 0 0 0 0 0 0
15900 25 14 0 0 14 0 14 0 7 7 10 0 0);
16000 TF[4] ← '(7 10 0 7 0 0 14 14 14 14 14 14 14 14 0 0 0 0 0 0
16100 14 10 0 0 25 0 25 0 10 10 14 0 5);
16200 TF[5] ← '(7 5 0 10 0 0 10 14 14 14 14 14 14 14 0 0 0 0 0 0
16300 25 14 0 0 14 0 14 0 7 7 7 0 0);
16400 TF[6] ← '(10 7 0 7 0 0 14 14 14 14 14 14 14 14 0 0 0 0 0 0
16500 14 10 0 0 25 0 25 0 10 10 10 0 5);
16600 TF[7] ← '(0 0 5 0 10 10 0 0 0 0 0 0 0 0 25 25 14 25 14 14
16700 0 0 7 7 0 14 0 14 0 0 0 5 0);
16800 TF[8]←TF[1]; TF[9]←TF[2];
16900 RETURN PRINTSTR '"SUCCESFUL END OF MAKELISTS";
17000 END;
17100 EXPR FALSE(A); NIL;
17200 EXPR TRUE(A); T;
17300 EXPR GETEX(N8);
17400 BEGIN NEW I;
17500 N9 ← LENGTH(EXAMPLE) + 1;
17600 IF N9=1 THEN RETURN PRIM(NIL);
17700 S; PRINTSTR '"PLEASE GIVE ME AN EXAMPLE.";
17800 PRINTSTR '" THE ARGUMENT LIST...";
17900 EXAMPLE[N9,1]←READ();
18000 PRINTSTR '"THE FUNCTION VALUE...";
18100 EXAMPLE[N9,2]←READ();
18200 PRINTSTR '"DID YOU MAKE AN ERROR? ";
18300 I←READ();
18400 IF I='Y THEN GO S;
18500 RETURN EXAMPLE[N9];
18600 END;
18700 EXPR PI12(A,B); A;
18800 EXPR PI22(A,B); B;
18900 EXPR ZERO1(A); 0;
19000 EXPR ZERO2(A,B); 0;
19100 EXPR CONST1(A); 1;
19200 EXPR CONST2(A,B); NIL;
19300 EXPR INFINITY();
19400 BEGIN
19500 INF←INF+1;
19600 RETURN LESSP(INF,LIMINF);
19700 END;
19800 EXPR REC(FN,A,N,RELATEDF);
19900 BEGIN
20000 NEW I,II,I1,I2,KK,JJ1,JJ2;
20100 S; PRINTSTR '"WHICH: TYPE AN R(RECURSION), A(AUX.FN.), OR
20200 B(BOTH)...";
20300 I←READ();
20400 IF NOT(MEMBER(I,'(R A B))) THEN
20500 PRINTSTR '"NO,NO!! TYPE R,A, OR B ONLY..."
20600 ALSO GO S;
20700 IF NOT I='R THEN RETURN '"O.K. LET'S WORK ON THE AUX.FN.
20800 TYPE IT IN AS IF IT WERE YOUR REQUEST:";
20900 I←GETEX(1);
21000 NEX←0;
21100 PRINTSTR '"HOW MANY MORE EXAMPLES WILL YOU GIVE ME
21200 (I SUGGEST 2) ....";
21300 NEX←READ();
21400 FOR NEW KK←1 TO NEX DO II←GETEX(KK+1);
21500 L←CADAR(A);
21600 NEX ← NEX + ONEX;
21700 IF NOT(N=1) THEN GO SS; I←'(ANY);
21800 E←NIL; MA←T; MN←T; MAL←T; EXAMPLE[NEX+2,1]←L;
21900 FOR NEW X←1 TO NEX+1 DO BEGIN E←EXAMPLE[X+1,1];
22000 MA←MA AND ATOM(E); MN←MN AND NUMBER(E);
22100 MAL←MAL AND ANYLIST(E); END;
22200 IF MAL THEN I←'(ANYLIST);
22300 IF MA THEN I←'(ATOM);
22400 IF MN THEN I←'(NUMBER);
22500 PUTPROP('FN,I,'TARGS);
22600 PUTPROP('FN,1,'NARGS);
22700 PUTPROP('FN,'ANY,'TRES);
22800 IHOLD←I;
22900 PRINTSTR '"DO YOU KNOW THE TYPE OF ARGUMENTS
23000 FOR THE FN? MY GUESS IS"; PRINC (IHOLD);
23100 PRINTSTR '"ANSWER Y IF YOU WANT TO MAKE A BETTER GUESS,
23200 N IF YOU THINK THAT IT IS O.K. AS STATED ... ";
23300 I←READ(); IF I='Y THEN BEGIN PRINTSTR '"O.K. TYPE IN ONE
23400 OF TH FOLLOWING WORDS: ANY ANYLIST LISTP NUMBER...";
23500 I←READ();
23600 PUTPROP('FN,<I>,'TARGS);
23700 IHOLD←I;
23800 END;
23900 FOR NEW K←1 TO 7 DO
24000 ORD[K]←INTERSECTION(RELATEDF[1]@
24100 RELATEDF[2]@<'FN>@RELATEDF[3]
24200 @RELATEDF[4],ORDER[K]);
24300 ORD[8]←ORD[1]; ORD[9]←ORD[2];
24400 FOR NEW K←1 TO 9 DO ORD[K]←RANK(K,ORD);
24500 PRINTSTR '"DO YOU WANT TO CUT DOWN THE POSSIBILITIES
24600 EVEN FURTHER? Y OR N ..."; I←READ();
24700 IF I='Y THEN FOR NEW X←1 TO 9 DO BEGIN
24800 PRINT (<'ORD,X,ORD[X]>); PRINTSTR '"NOW RETYPE ORD[X]";
24900 I ← READ(); IF NOT(I='S) THEN ORD[X]←I;
25000 END;
25100 IF C1=UNKNOWN THEN C1←T;
25200 IF C3=UNKNOWN THEN C3←T;
25300 I←NIL; II←NIL;
25400 LIMINF←LIMINFBASE;
25500 FOR NEW T1←1 TO LENGTH(ORD[1]) DO BEGIN
25600 F1←ORD[1,T1];
25700 IF GREATERP(MSGLEVEL,0) THEN
25800 PRINT(<1,'T1,T1,'F1,F1,'L,L,'RELATEDF,RELATEDF,'ORD,ORD>);
25900 IF FOR NEW X←2 TO NEX+1 ; AND BEGIN
26000 E←EXAMPLE[X,1];
26100 RETURN EVAL '((CAR (GET F1 TARGS)) E) ;
26200 END AND
26300 (GOODEX=NIL OR F1(GOODEX[1])=C1) THEN
26400 FOR NEW T2←1 TO LENGTH(ORD[2]) DO BEGIN
26500 F2←ORD[2,T2];
26600 IF GREATERP(MSGLEVEL,1) THEN
26700 PRINT(<2,'T2,T2,'F2,F2>);
26800 IF FOR NEW X←2 TO NEX+1; AND BEGIN
26900 E←EXAMPLE[X,1];
27000 RETURN EVAL '((CAR (GET F2 TARGS)) E) ;
27100 END AND
27200 (NOT(GOODEX) OR F2(GOODEX[1])=GOODEX[2]) THEN
27300 FOR NEW T8←1 TO LENGTH(ORD[8]) DO BEGIN
27400 F8←ORD[8,T8];
27500 IF GREATERP(MSGLEVEL,9) THEN PRINT(<8,'T8,T8,'F8,F8>);
27600 IF FOR NEW X←2 TO NEX+1; AND BEGIN
27700 E←EXAMPLE[X,1];
27800 RETURN EVAL '((CAR (GET F8 TARGS)) E); END AND
27900 (GOODEX2=NIL OR F8(GOODEX2[1])=C3) THEN
28000 FOR NEW T9←1 TO LENGTH(ORD[9]) DO BEGIN
28100 F9←ORD[9,T9];
28200 IF GREATERP (MSGLEVEL,10) THEN PRINT(<9,'T9,T9,'F9,F9>);
28300 IF FOR NEW X←2 TO NEX+1; AND BEGIN
28400 E←EXAMPLE[X,1];
28500 RETURN EVAL '((CAR (GET F9 TARGS)) E); END AND
28600 (NOT(GOODEX2) OR F9(GOODEX2[1])=GOODEX2[2]) THEN
28700 FOR NEW T3←1 TO LENGTH(ORD[3]) DO BEGIN
28800 F3←ORD[3,T3];
28900 IF GREATERP(MSGLEVEL,2) THEN
29000 PRINT(<3,'T3,T3,'F3,F3>);
29100 IF FOR NEW X←2 TO NEX+1; AND BEGIN
29200 E←EXAMPLE[X,1];
29300 RETURN ( GT(E) OR EVAL '((CAR (GET F3 TARGS)) E) );
29400 END THEN
29500 FOR NEW T4←1 TO LENGTH(ORD[4]) DO BEGIN
29600 F4←ORD[4,T4];
29700 IF F4='FN THEN LIMINF← LIMINF + LIMINF;
29800 IF GREATERP(MSGLEVEL,3) THEN
29900 PRINT(<4,'T4,T4,'F4,F4,'GETF4TARGS,GET(F4,TARGS)>);
30000 IF FOR NEW X←2 TO NEX+1; AND BEGIN
30100 E←EXAMPLE[X,1];
30200 RETURN ( GT(E) OR EVAL '((CAR (GET F4 TARGS)) (F3 E) )) ;
30300 END THEN
30400 FOR NEW T5←1 TO LENGTH(ORD[5]) DO BEGIN
30500 F5←ORD[5,T5];
30600 IF GREATERP(MSGLEVEL,4) THEN
30700 PRINT (<5,'T5,T5,'F5,F5>);
30800 IF FOR NEW X←2 TO NEX+1; AND BEGIN
30900 E←EXAMPLE[X,1];
31000 RETURN (GT(E) OR EVAL '((CAR (GET F5 TARGS)) E)) ;
31100 END THEN
31200 FOR NEW T6←1 TO LENGTH(ORD[6]) DO BEGIN
31300 F6←ORD[6,T6];
31400 IF F6='FN THEN LIMINF← LIMINF + LIMINF;
31500 IF GREATERP(MSGLEVEL,5) THEN
31600 PRINT (<6,'T6,T6,'F6,F6,'(I HAVE CHOSEN LIMINF TO BE),LIMINF>);
31700 IF FOR NEW X←2 TO NEX+1; AND BEGIN
31800 E←EXAMPLE[X,1];
31900 RETURN ( GT(E) OR EVAL '((CAR (GET F6 TARGS)) (F5 E) )) ;
32000 END THEN
32100 FOR NEW T7←1 TO LENGTH(ORD[7]) DO BEGIN
32200 F7←ORD[7,T7];
32300 IF GREATERP(MSGLEVEL,6) THEN
32400 PRINT (<7,'T7,T7,'F7,F7>);
32500 JJ1← FOR NEW KK←2 TO NEX+2; AND BEGIN E←EXAMPLE[KK,1];
32600 RETURN (GT(E) OR
32700 EVAL('((CAR (GET F7 TARGS)) (F4 (F3 E))))); END;
32800 JJ2← FOR NEW HH←2 TO NEX+2; AND BEGIN E←EXAMPLE[HH,1];
32900 RETURN (GT(E) OR
33000 EVAL ('((CADR (GET F7 TARGS)) (F6 (F5 E)))))
33100 ; END;
33200 IF JJ1 AND JJ2 THEN INF←0
33300 ALSO I← FOR NEW X←2 TO NEX+1; AND BEGIN
33400 INF←0;
33500 E←EXAMPLE[X,1];
33600 RETURN (EXAMPLE[X,2] = EVAL '(FN E) );
33700 END;
33800 IF I THEN PRINTSTR '"
33900 HOORAY, HOORAY!!!
34000 SUCCESS!!
34100 ";
34200 RETURN I;
34300 END UNTIL I
34400 END UNTIL I
34500 END UNTIL I
34600 END UNTIL I
34700 END UNTIL I
34800 END UNTIL I
34900 END UNTIL I
35000 END UNTIL I
35100 END UNTIL I;
35200 IF GREATERP(MSGLEVEL,0) THEN
35300 PRINT <'F123456789,F1,F2,F3,F4,F5,F6,F7,F8,F9,'C1234,C1,C2,C3,C4>;
35400 KNOWNF← FN CONS KNOWNF; TARG ←GET('FN,'TARGS) CONS TARG;
35500 NARG←N CONS NARG; TRE ← GET('FN,'TRES) CONS TRE;
35600 BA1 ← FN CONS BA1; IF GREATERP(MSGLEVEL,2) THEN
35700 PRINT <'KNOWNF,KNOWNF,
35800 'TARGNARGTRE,TARG,NARG,TRE,'BA1,BA1>;
35900 FINALIZE();
36000 PUTPROP(FN,1,NARGS);
36100 PUTPROP(FN,IHOLD,TARGS);
36200 PUTPROP(FN,'(ANY),TRES);
36300 FOR NEW J←1 TO 9 DO PUTPROP(FN,11,PF[J]);
36400 RETURN FN; SS; RETURN '"SORRY, THIS ISN'T PROGRAMMED YET.";
36500 END;
36600 EXPR GT(E);
36700 OR( GOODEX AND GOODEX[1]=E, GOODEX2 AND GOODEX2[1]=E);
36800 EXPR INTERSECTION(A,B);
36900 BEGIN NEW III;
37000 III←NIL;
37100 FOR NEW JJJ IN A DO
37200 IF MEMBER(JJJ,B) THEN III← III @ <JJJ>;
37300 RETURN III;
37400 END;
37500 EXPR LISTP(A);AND( NOT(ATOM(A)), LENGTH(A) ≥ 1);
37600 EXPR ANY(A); T;
37700 EXPR NUMBER(A); NUMBERP(A);
37800 EXPR ANYLIST(A);OR(NULL(A),NOT(ATOM(A)));
37900 EXPR PRINTMATRIX();
38000 BEGIN NEW J;
38100 PRINTSTR '"FNAME TF1 TF2 TF3 TF4 TF5 TF6 TF7 TF8 TF9";
38200 FOR NEW I IN KNOWNF DO BEGIN
38300 J← FOR NEW K IN PF COLLECT
38400 <GET(I,K)>;
38500 RETURN PRINT (I CONS J);
38600 END;
38700 END;
38800 EXPR PRIM(NIL);
38900 BEGIN NEW I,I1,I2;
39000 GOODEX←NIL;
39100 GOODEX2 ← NIL;
39200 F8←NIL;
39300 F9←NIL;
39400 ONEX ← 0;
39500 F1 ← NIL;
39600 F2 ← NIL;
39700 UNKNOWN ← 'UNKNOWN;
39800 PRINTSTR '"THERE IS SOME TRIVIAL (PRIMITIVE) CASE (OR TWO).
39900 DO YOU KNOW ANYTHING ABOUT IT? Y OR N ...";
40000 I ← READ();
40100 IF I ='N THEN BEGIN
40200 IF GREATERP(MSGLEVEL,1) THEN PRINTSTR
40300 '"ASSUMING C1 TO BE T, C2 TO BE UNKNOWN";
40400 C1 ← T; C2 ← UNKNOWN;
40500 C3←T; C4←UNKNOWN;
40600 EXAMPLE[1] ← <C1,C2>;
40700 RETURN NIL; END ALSO RETURN NIL;
40800 PRINTSTR '"FOR SOME FUNCTIONS F1,F2 AND SOME CONSTANTS C1,C2
40900 WHEN F1(ARGUMENT)=C1 THEN THE VALUE OF YOUR FN IS C2=F2(ARG)
41000 NOTE: C2 MAY NOT ACTUALLY BE A CONSTANT (JUST TYPE UNKNOWN)
41100
41200 NOW TYPE IN A FUNCTION NAME OR THE WORD NIL FOR F1,F2
41300 AND A CONSTANT OR TH WORD UNKNOWN FOR C1,C2 :
41400 F1 ...";
41500 F1←READ();
41600 PRINTSTR '" F2 ...";
41700 F2 ← READ();
41800 PRINTSTR '" C1 ...";
41900 C1 ← READ();
42000 PRINTSTR '" C2 ...";
42100 C2 ← READ();
42200 EXAMPLE[1] ← <C1,C2>;
42300 PRINTSTR '"CAN YOU GIVE ME AN EXAMPLE OF THIS TRIVIAL CASE? ";
42400 PRINTSTR '"Y OR N ...";
42500 I ← READ();
42600 IF I='Y THEN I←GETEX(2) ALSO ONEX←1 ALSO GOODEX←EXAMPLE[2];
42700 IF GOODEX AND F1 THEN C1←F1(GOODEX[1]);
42800 IF GOODEX AND F2 THEN C2←F2(GOODEX[1]);
42900 PRINTSTR '"IS THERE ANOTHER TRIVIAL CASE? Y OR N...";
43000 I←READ();
43100 IF I='N THEN BEGIN
43200 C3←T; C4←UNKNOWN;
43300 F8←'FALSE; F9←'FALSE;
43400 END
43500 ALSO RETURN NIL;
43600 PRINTSTR '"FOR SOME FUNCTIONS F8,F9, AND SOME CONSTANTS C3,C4
43700 WHEN F8(ARGUMENT)=C3 HEN THE VALUE OF YOUR FUNCTION
43800 IS C3=F9(ARGUMENT)
43900 NOTE: C4 MAY NOT ACTUALLY BE A CONSTANT (SAY UNKNOWN)
44000
44100 AS BEFORE, TYPE IN SOMETHING FOR ....
44200 F8 F9 C3 C4 HERE:";
44300 F8←READ();F9←READ();C3←READ();C4←READ();
44400 PRINTSTR '"CAN YOU GIVE ME AN EXAMPLE OF THIS TRIVIAL CASE?
44500 Y OR N ...";
44600 I←READ();
44700 IF I='Y THEN I←GETEX(3) ALSO ONEX←ONEX+1 ALSO GOODEX2←EXAMPLE[3];
44800 IF GOODEX2 AND F8 THEN C3←F8(GOODEX2[1]);
44900 IF GOODEX2 AND F9 THEN C4←F9(GOODEX2[1]);
45000 RETURN NIL; END;
45100 EXPR RANK(K,LL);
45200 BEGIN NEW VAL,TEMP,OLDR,RL;
45300 L←LL;
45400 IF NULL(L[K]) THEN
45500 (IF K=7 THEN RETURN '(PI22) ELSE RETURN '(IDEN));
45600 IF K=1 AND F1 THEN RETURN <F1>;
45700 IF K=2 AND F2 THEN RETURN <F2>;
45800 IF K=8 AND F8 THEN RETURN <F8>;
45900 IF K=9 AND F9 THEN RETURN <F9>;
46000 VAL←NIL;
46100 II←NIL;
46200 II←L[K];
46300 L←II;
46400 LEN ← LENGTH(L);
46500 OLDL←L;
46600 FOR NEW II ←1 TO LEN DO
46700 BEGIN
46800 I←L[II];
46900 IF MEMBER(I,KNOWNF) AND
47000 GET(I,'RVAL) AND
47100 GET(I, PF[K]) AND NOT(GET(I,PF[K])=0) THEN
47200 VAL[II] ← TIMES( GET(I,PF[K]), GET(I,'RVAL))
47300 ELSE VAL[II] ← 1000;
47400 END;
47500 IF GREATERP(MSGLEVEL,20) THEN
47600 PRINT(<'VAL,VAL,'L,L>);
47700 FOR NEW KOUNTER←1 TO LEN DO
47800 FOR NEW I1←1 TO LEN-1 DO
47900 FOR NEW I2←I1+1 TO LEN DO
48000 IF GREATERP(VAL[I1],VAL[I2]) THEN BEGIN
48100 TEMP←VAL[I1]; VAL[I1]←VAL[I2]; VAL[I2]←TEMP;
48200 TEMP←L[I1]; L[I1]←L[I2]; L[I2]←TEMP;
48300 END;
48400 RL←L;
48500 TEMP← FOR NEW J←1 TO LEN COLLECT
48600 BEGIN IF VAL[J]=1000 THEN RETURN NIL
48700 ELSE RETURN <L[J]>;
48800 END;
48900 L ← TEMP;
49000 IF GREATERP(MSGLEVEL,9) THEN PRINT (<'OLDL,OLDL,'RANKEDL,
49100 RL, 'CHOPPEDL, L>);
49200 RETURN L;
49300 END;
49400 EXPR FINALIZE();
49500 BEGIN
49600 IF F4='FN THEN F4←FN; IF F6='FN THEN F6←FN;
49700 EVAL <'DE, FN, '(L),
49800 <'COND, <<'EQUAL, <F1, 'L>, C1>, <F2,'L>>,
49900 <<'EQUAL, <F8, 'L>, C3>, <F9, 'L>>,
50000 <'T,<F7, <F4, <F3, 'L>>,
50100 <F6, <F5, 'L>>>>>>;
50150 RETURN KEEP();
50200 END;
50300 EXPR PERMANENT();
50400 BEGIN NEW I;
50500 EVAL '(OUTC (OUTPUT DSK: PW1KNOWNF) NIL);
50600 PRINT(<KNOWNF,TARG,NARG,TRE,
50700 BA1,BA2> );
50800 EVAL '(OUTC NIL T);
50900 END;
51000 EXPR KEEP();
51100 BEGIN NEW I;
51200 PRINTSTR '"THE ANSWER TO YOUR REQUEST IS";
51300 PRINT (EVAL(LHOLD));
51400 PRINTSTR '"
51500
51600 DO YOU WISH TO ENTER THIS FUNCTION AS A PERMANENT PART
51700 OF THE SYSTEM? Y OR N...";
51800 I←READ();
51900 IF I='N THEN RETURN NIL;
52000 I← PERMANENT();
52100 IF GREATERP(MSGLEVEL,23) THEN PRINT
52200 (<'KNOWNF,KNOWNF,'TARG,TARG,'NARG,NARG,'TRE,TRE,'BA1,
52300 BA1,'BA2,BA2>);
52400 RETURN NIL; END;
52500 EXPR READINKNOWN();
52600 BEGIN NEW I;
52700 I←EVAL '(INC (INPUT DSK: PW1KNOWNF) NIL);
52800 IDATA←NIL;
52900 IDATA← READ();
53000 I←EVAL '(INC NIL T);
53100 IF GREATERP(MSGLEVEL ,24) THEN PRINT (<'IDATA,
53200 IDATA>);
53300 RETURN NIL; END;
53400 END.